home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBPARMS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  11KB  |  397 lines
  1. {SECTION ..PbPARMS }
  2. UNIT PbPARMS;
  3.  
  4. INTERFACE
  5.  
  6. Uses  Dos, PbMISC, PbDATA, PbOBJS;
  7.  
  8.  
  9. {
  10. Description:  Support for configuration files and param line handling
  11.  
  12. Author      : Howard Richoux
  13. Date        : 1/26/91    major rewrite
  14. Last revised: 11/20/93   re-added multilevel CFG files
  15.                          standard variables
  16.                          DOC file support
  17.                12/7/93   add optional extra cfg file
  18.                12/21/93  add ScanParms
  19.                1/3/94    cleanup
  20.                1/29/94   StandardpVarsInit writes Placed in the Public Domain by message
  21.                2/13/94   Added c:\HNR.CFG as Global Default
  22.                2/17/94   cut over to PbMISC/PbDATA/PbOBJS
  23. Application : IBM PC and compatibles, Turbo Pascal 5.0
  24. Status      : Placed in the Public Domain by HNR Software 1/94
  25. Published in: none
  26.  
  27.   Total rewrite of PbPARMS unit using the INFO_object.
  28.  
  29.   Routines to support the use of config files and param lines by programs
  30.    HNR 12/13/88
  31.     Config files contain entries such as:
  32.       OUTPUT=CON
  33.       DISPLAY=YES
  34.     They are loaded in from one or more files into an array and accessed
  35.      by name at any time.  Either the actual value can be retrieved
  36.     or a numeric or boolean interpretation.
  37.  
  38.      <pid>   --> parameter identifier, an 8 character string
  39.      <pval>  --> string value of parameter (24 chars), unit also
  40.                   keeps a boolean interpretation, and can be accessed
  41.                   as a numeric value
  42.  
  43. StandardpVarsInit - sets a group of standard variables, free decoding:
  44.     Internal   External(CFG)    Possible Use                   Default
  45.     --------   --------         ---------------------------    -------
  46.     pFirst     FIRST=<nnn>      First record number to keep    0
  47.     pLast      LAST=<nnn>       Last record number to keep     32700
  48.     pCount     COUNT=<nnn>      Number of records to keep      32700
  49.     pRecs      RECS=<nnn>       Number of records to keep      32700
  50.     pSkip      SKIP=<nnn>       Number of records to skip      0
  51.     pSize      SIZE=<nnn>       Record size                    16
  52.     pDelay     DELAY=<nnn>      millisecond delay              100
  53.  
  54.     pDataPath  DATAPATH=xx..x   Data directory                 ''
  55.     pOutFile                    CON LPT1, ...                  'CON'
  56.  
  57.     pDebug     DEBUG=ON         Turn On/Off debugging          false
  58.  
  59.     pExtraCFG  EXTRA=fspec      secondary CFG file             ''
  60.     pSystemID  SYSTEM=xxx       TAG to identify system         ''
  61.     pPrinterID PRINTER=xxxx     TAG to identify printer type   'LJ4'
  62.  
  63.     pProgID                     ID & version # of program      '<progid>'
  64.     pCurrFName                  file being operated on         ''
  65. }
  66.  
  67.  
  68. {SECTION .PARM_object }
  69. {-}
  70. type  PARM_object = object(INFO_object)
  71.           CONSTRUCTOR init(max : integer);
  72.           Procedure merge (fname : string);
  73.           Procedure DecodePARMString(s : string);
  74.           Procedure ParamLineOverride;
  75.           end;
  76.  
  77. var parms : PARM_object;   { mostly private }
  78. {+}
  79.  
  80. {SECTION .PROCEDURES }
  81.  
  82.  
  83. Procedure PARMSetFirstLast;
  84.              {[PARMS] resolve conflicts between first last and count}
  85.  
  86. Procedure StandardpVarsInit;
  87.              {[PARMS] * Primary Call * (unless using StandardOUTInit)}
  88.  
  89. Procedure ShowDOCfile;
  90.              {[PARMS] Display Instructions from the *.DOC file}
  91.  
  92. Function  GetParmStr(pid : string) : string;
  93.              {[PARMS] Check a PARM - returns param string value}
  94.  
  95. Function  GetParmNum(pid : string) : word;
  96.              {[PARMS] Check a PARM - returns numeric value}
  97.  
  98. Function  CheckOK(pid : string) : boolean;
  99.              {[PARMS] Check a PARM - returns boolean value}
  100.  
  101. Procedure SetParmFileDefault;
  102.              {[PARMS] sets file as .CFG from .EXE - goes through sequence}
  103.  
  104. Procedure ParamLineOverride;
  105.              {[PARMS] takes params of param line - mostly internal}
  106.  
  107. Procedure AddParm(pfnum : byte; pid,pval : string);
  108.              {[PARMS] Add your own PARM w/default, or set default on standard PARM }
  109.  
  110. Procedure ListParms(pfnum : byte);
  111.              {[PARMS] for debugging }
  112.  
  113. Function  ScanParms(str : string) : boolean;
  114.              {[PARMS] - searches parm line for "STR" }
  115.  
  116.  
  117. {SECTION .zImplementation }
  118. IMPLEMENTATION
  119.  
  120. Procedure InitIt; forward;
  121.  
  122. {SECTION  AddParm }
  123. Procedure AddParm(pfnum : byte; pid,pval : string); { for Init procs }
  124. var ok : boolean;
  125.      begin
  126.      if not parmsinitted then InitIt;
  127.      ok := parms.store(pid,pval);
  128.      end;
  129.  
  130.  
  131. {SECTION  CheckOK }
  132. Function  CheckOK(pid : string) : boolean;    {returns boolean value}
  133.      begin
  134.      CheckOK :=  parms.fetchboolean(pid);
  135.      end;
  136.  
  137.  
  138. {SECTION  GetParmNum }
  139. Function  GetParmNum(pid : string) : word;    {returns numeric value}
  140.      begin
  141.      GetParmNum := parms.fetchinteger(pid);
  142.      end;
  143.  
  144.  
  145. {SECTION  GetParmStr }
  146. Function  GetParmStr(pid : string) : string;  {returns param string value}
  147.      begin
  148.      GetParmStr :=  parms.fetchstring(pid);
  149.      end;
  150.  
  151.  
  152. {SECTION  InitIt }
  153. Procedure InitIt;
  154.      begin
  155.      parms.init(100);
  156.      parmsinitted := true;
  157.      end;
  158.  
  159.  
  160. {SECTION  InitpVars }
  161. Procedure InitpVars;
  162.      begin
  163.      AddParm(1,'COUNT','32700');
  164.      AddParm(1,'DATAPATH','');
  165.      AddParm(1,'DEBUG','NO');
  166.      AddParm(1,'DELAY','100');
  167.      AddParm(1,'EXTRA','');
  168.      AddParm(1,'FIRST','0');
  169.      AddParm(1,'LAST','32700');
  170.      AddParm(1,'OUT','CON');
  171.      AddParm(1,'RECS','32700');
  172.      AddParm(1,'SIZE','16');
  173.      AddParm(1,'SKIP','0');
  174.      AddParm(1,'SYSTEM','');
  175.      AddParm(1,'PRINTER','LJ4');
  176.      end;
  177.  
  178.  
  179. {SECTION  ListParms }
  180. Procedure ListParms(pfnum : byte);
  181.      begin
  182.      parms.dump;
  183.      end;
  184.  
  185.  
  186. {SECTION  ParamLineOverride }
  187. Procedure ParamLineOverride;                  {takes params of param line}
  188.      begin
  189.      parms.paramlineoverride;
  190.      end;
  191.  
  192.  
  193. {SECTION  PARMSetFirstLast }
  194. Procedure PARMSetFirstLast;
  195.      begin
  196.      if pFirst < 1 then pFirst := 1;
  197.      if      (pCount <> 32700) and (pLast = 32700) then
  198.           pLast := pFirst + pCount - 1
  199.      else if (pCount = 32700) and (pLast <> 32700) then
  200.           pCount := pLast - pFirst + 1
  201.      else if (pCount <> 32700) and (pLast <> 32700) then
  202.           pLast := pFirst + pCount - 1;
  203.      end;
  204.  
  205.  
  206. {SECTION PARM_object }
  207. CONSTRUCTOR PARM_object.init(max : integer);
  208. var l : longint;
  209.     i : integer;
  210.      begin
  211.      sepchar := '=';  { separator between key and data }
  212.      infoheader.init;
  213.      keystring.init(max);
  214.      keyvalue.init(max);
  215.      end;
  216.  
  217.  
  218. Procedure PARM_object.DecodePARMString(s : string);
  219. var pid,pval : string;
  220.     OK : boolean;
  221.      begin
  222.      pval := s;
  223.      RemoveDelimitedString(pval,'{','}');  {throw away comments}
  224.      pid := UpCaseStr(GetLeftStr(pval,sepchar));
  225.      trim(pval);
  226.      if pid <> '' then ok := INFO_object.store(pid,pval);
  227.      end;
  228.  
  229.  
  230. Procedure PARM_object.merge(fname : string);
  231. var fn : string[60];
  232.     s  : string;
  233.     OK : boolean;
  234.     TEXTF : text;
  235.      begin
  236.      fn := fname;
  237.      if fn = '' then
  238.           begin
  239.           fn := paramstr(0);
  240.           ForceExt(fn,'.CFG');
  241.           end;
  242.      assign(TEXTF, fn);
  243.      {$I-} reset(TEXTF);  {$I+}
  244.      OK := (IORESULT = 0);
  245.      if not ok then exit;
  246.      while ok and (not EOF(TEXTF)) do
  247.          begin
  248.          readln(TEXTF, s);
  249.          if (INFO_object.count = 0) and (s[1] = '*') then
  250.               begin
  251.               delete(s,1,1);
  252.               ok := infoheader.store(s);
  253.               end
  254.          else if (s <> '') and (s[1] <> '*') then
  255.               begin
  256.               DecodePARMString(s);
  257.               end;
  258.          end;
  259.      {$I-} Close(TEXTF); {$I+}
  260.      end;
  261.  
  262.  
  263.  
  264. Procedure PARM_object.ParamLineOverride;
  265. var i,j : integer;
  266.     s : string;
  267.     begin
  268.     if paramcount > 0 then
  269.         begin
  270.         for j := 1 to paramcount do
  271.             begin
  272.             s := paramstr(j);
  273.             if (s[1] = '/') or (s[1] = '-') then
  274.                  begin
  275.                  delete(s,1,1);
  276.                  DecodePARMString(s);
  277.                  end
  278.             else begin
  279.                  i := pos(sepchar,s);
  280.                  if i > 0 then PARM_object.DecodePARMString(s);
  281.                  end;
  282.             end;
  283.         end;
  284.     end;
  285.  
  286.  
  287.  
  288. {SECTION ScanParms }
  289. Function ScanParms(str : string) : boolean;
  290.      {[PARMS] - searches parm line for "STR"}
  291. var s1 : string;
  292.     i  : integer;
  293.      begin
  294.      ScanParms := false;
  295.      s1 := UpCaseStr(str);
  296.      i := 1;
  297.      while i <= paramcount do
  298.           begin
  299.           if UpCaseStr(paramstr(i)) = s1 then ScanParms := true;
  300.           inc(i);
  301.           end;
  302.      end;
  303.  
  304.  
  305.  
  306. {SECTION  SetParmFileDefault }
  307. Procedure SetParmFileDefault;                 {sets file as .CFG from .EXE}
  308. var s,dir,nam,ext : string;
  309.      begin
  310.      if not parmsinitted then InitIt;
  311.  
  312.      s := 'C:\HNR.CFG';      {System Level Global CFG file}
  313.      forceext(s,'cfg');
  314.      parms.merge(s);
  315.  
  316.      s := paramstr(0);       {The CFG file with the EXE}
  317.      forceext(s,'cfg');
  318.      parms.merge(s);
  319.  
  320.      FSplit(s,dir,nam,ext);  {The CFG file in the current directory}
  321.      s := nam;
  322.      forceext(s,'cfg');
  323.      parms.merge(s);
  324.  
  325.      pExtraCFG := GetParmStr('EXTRA');
  326.      if (pExtraCFG <> '') and FileExists(pExtraCFG) then
  327.           begin
  328.           writeln('Loading extra CFG file [',pExtraCFG,']');
  329.           parms.merge(pExtraCFG);
  330.           end
  331.      else if pExtraCFG <> '' then
  332.           writeln('NOT FOUND Extra CFG file [',pExtraCFG,']');
  333.      end;
  334.  
  335.  
  336. {SECTION  ShowDOCFile }
  337. Procedure ShowDOCFile;   {Display Instructions}
  338. var fn,s  : string;
  339.     OK    : boolean;
  340.     TEXTF : text;
  341.      begin
  342.      fn := paramstr(0);   {The DOC file with the EXE}
  343.      forceext(fn,'doc');
  344.      if fn = '' then
  345.           begin
  346.           fn := paramstr(0);
  347.           ForceExt(fn,'.CFG');
  348.           end;
  349.      assign(TEXTF, fn);
  350.      {$I-} reset(TEXTF);  {$I+}
  351.      OK := (IORESULT = 0);
  352.      if not ok then exit;
  353.      while ok and (not EOF(TEXTF)) do
  354.          begin
  355.          readln(TEXTF, s);
  356.          if s[1] = '?'then OK := false else writeln(s);
  357.          end;
  358.      {$I-} Close(TEXTF); {$I+}
  359.      end;
  360.  
  361.  
  362. {SECTION  StandardpVarsInit }
  363. Procedure StandardpVarsInit;
  364.      begin
  365.  
  366.      SetParmFileDefault;
  367.      ParamLineOverride;
  368.  
  369.  
  370.      pCount    := trunc(GetParmNum('COUNT'));
  371.      pDataPath := GetParmStr('DATAPATH');
  372.      pDebug    := CheckOK('DEBUG');
  373.      pFirst    := trunc(GetParmNum('FIRST'));
  374.      pLast     := trunc(GetParmNum('LAST'));
  375.      pSize     := trunc(GetParmNum('SIZE'));
  376.      pSkip     := trunc(GetParmNum('SKIP'));
  377.      pRecs     := trunc(GetParmNum('RECS'));
  378.      pDelay    := trunc(GetParmNum('DELAY'));
  379.  
  380.      pOutFile  := UpCaseStr(GetParmStr('OUT'));
  381.      pSystemID := UpCaseStr(GetParmStr('SYSTEM'));
  382.      pPrinterID := UpCaseStr(GetParmStr('PRINTER'));   { LJ4, NONE, SIMPLE }
  383.  
  384.      PARMSetFirstLast;
  385.      writeln(pProgID,'  Placed in the Public Domain by HNR Software 2/12/94.');
  386.      writeln('');
  387.      end;
  388.  
  389.  
  390. {SECTION  zzInitialization }
  391.      begin {initialization }
  392.      InitpVars;
  393.      END.
  394.  
  395.  
  396.  
  397.